home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Textdisplayers / MuchMore 4.6 / Tools / ForceMuchMore / ForceMuchMore.mod < prev    next >
Text File  |  1996-09-26  |  3KB  |  152 lines
  1.  
  2. MODULE ForceMuchMore;
  3.  
  4.   (* $IFNOT SmallData *)
  5.  
  6.   IMPORT
  7.     ol := OberonLib,
  8.     d  := Dos,
  9.     e  := Exec,
  10.     es := ExecSupport,
  11.     ic := Icon,
  12.     wb := Workbench,
  13.     SYS:= SYSTEM;
  14.  
  15.   TYPE
  16.     GetIconProc = PROCEDURE (name{8}:e.STRPTR; icon{9}:wb.DiskObjectPtr; freelist{10}:e.APTR): LONGINT;
  17.  
  18.   CONST
  19.     version = "\o$VER: forcemuchmore 1.0 (11.3.95)";
  20.     portName = "ForceMuchMore";
  21.  
  22.   VAR
  23.     oldProc   : GetIconProc;
  24.     sig       : LONGSET;
  25.     base      : e.APTR;
  26.     i         : LONGINT;
  27.     icon      : wb.DiskObjectPtr;
  28.     replace   : e.STRING;
  29.     tools     : e.STRING;
  30.     tt        : e.LSTRPTR;
  31.     wbm       : wb.WBStartupPtr;
  32.     olddir    : d.FileLockPtr;
  33.     port      : e.MsgPortPtr;
  34.     halt      : BOOLEAN;
  35.  
  36.  
  37.   (* $StackChk- $RangeChk- $NilChk- $OvflChk- *)
  38.  
  39.   PROCEDURE StrChk (s1,s2: e.LSTRPTR): BOOLEAN;
  40.     VAR i,j : LONGINT;
  41.         ch  : CHAR;
  42.   BEGIN
  43.     i := 0; j := 0;
  44.     WHILE s1[i] # 0X DO INC(i) END;
  45.     WHILE (i>0) & (s1[i-1] # ":") & (s1[i-1] # "/") DO DEC(i) END;
  46.     REPEAT
  47.       ch := CAP(s2[j]); IF ch="|" THEN ch := 0X END;
  48.       IF CAP(s1[i]) # ch THEN RETURN FALSE END;
  49.       INC(i); INC(j)
  50.     UNTIL s1[i-1] = 0X;
  51.     RETURN TRUE;
  52.   END StrChk;
  53.  
  54.  
  55.   (* $SaveRegs+ *)
  56.  
  57.   PROCEDURE MyGetIcon(name{8}:e.STRPTR; icon{9}:wb.DiskObjectPtr; freelist{10}:e.APTR): LONGINT;
  58.     VAR dt,sp : e.LSTRPTR;
  59.         res,i : LONGINT;
  60.   BEGIN
  61.     res := oldProc(name,icon,freelist);
  62.     IF (res # 0) & (icon.type=wb.project) THEN
  63.       dt := icon.defaultTool;
  64.       IF dt # NIL THEN
  65.         sp := SYS.ADR(tools);
  66.         WHILE sp[0] # 0X DO
  67.           IF StrChk(dt,sp) THEN
  68.             icon.defaultTool := SYS.ADR(replace);
  69.           END;
  70.           i := 0;
  71.           WHILE (sp[i]#0X) & (sp[i]#"|") DO INC(i) END;
  72.           IF sp[i]="|" THEN INC(i) END;
  73.           sp := SYS.ADR(sp[i]);
  74.         END;
  75.       END;
  76.     END;
  77.     RETURN res;
  78.   END MyGetIcon;
  79.  
  80.  
  81.   (* $StackChk= $RangeChk= $NilChk= $OvflChk= *)
  82.  
  83. BEGIN
  84.   IF version[0]=0X THEN END;
  85.  
  86.   olddir := SYS.VAL(e.APTR,-1);
  87.   halt := FALSE;
  88.  
  89.  
  90.   base := ic.base;
  91.  
  92.   IF (base=NIL) OR (d.base.lib.version<37) THEN
  93.     HALT(d.fail)
  94.   END;
  95.  
  96.  
  97.   e.Forbid;
  98.  
  99.    port := e.FindPort(portName);
  100.    IF port # NIL THEN
  101.      e.Signal(port.sigTask,LONGSET{d.ctrlC});
  102.      port := NIL;
  103.      halt := TRUE;
  104.    END;
  105.  
  106.   e.Permit;
  107.  
  108.   IF halt THEN HALT(0) END;
  109.  
  110.  
  111.   port := es.CreatePort(portName,0);
  112.  
  113.  
  114.   IF ol.wbStarted THEN
  115.     wbm := ol.wbenchMsg;
  116.     olddir := d.CurrentDir(wbm.argList[0].lock);
  117.     COPY(wbm.argList[0].name^,replace);
  118.   ELSE
  119.     IF d.GetProgramName(tools,LEN(tools)) THEN END;
  120.     replace := "PROGDIR:";
  121.     e.CopyMem(d.FilePart(tools)^,replace[8],LEN(replace)-8);
  122.   END;
  123.  
  124.   icon := ic.GetDiskObject(replace);
  125.  
  126.   replace := "";
  127.   tools := "";
  128.  
  129.   IF icon # NIL THEN
  130.     tt := ic.FindToolType(icon.toolTypes,"TOOLS");   IF tt # NIL THEN COPY(tt^,tools) END;
  131.     tt := ic.FindToolType(icon.toolTypes,"REPLACE"); IF tt # NIL THEN COPY(tt^,replace) END;
  132.     ic.FreeDiskObject(icon);
  133.   END;
  134.  
  135.  
  136.   oldProc := SYS.VAL(GetIconProc,e.SetFunction(base,-42,SYS.VAL(e.PROC,MyGetIcon)));
  137.  
  138.   sig := e.Wait(LONGSET{d.ctrlC});
  139.   IF ~ol.wbStarted THEN d.PrintF("***Break\n") END;
  140.  
  141. CLOSE
  142.  
  143.   IF oldProc # NIL THEN SYS.SETREG(0,e.SetFunction(base,-42,SYS.VAL(e.PROC,oldProc))); d.Delay(50) END;
  144.   IF SYS.VAL(LONGINT,olddir) # -1 THEN olddir := d.CurrentDir(olddir) END;
  145.   IF port # NIL THEN es.DeletePort(port) END;
  146.  
  147.   (* $END *)
  148.  
  149. END ForceMuchMore.
  150.  
  151.  
  152.